home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
pascal
/
compat.exe
/
RUNTEST.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1992-06-26
|
2KB
|
110 lines
Program RUNTEST;
{$V-,X+,D+,B-,R- }
uses
Crt, Objects, Drivers, Views, Menus, App, Compat;
const
cmTestA = 101; { random-size TP window }
cmTestB = 102; { full-screen TP window }
type
TMyApp = OBJECT (TApplication)
procedure HandleEvent (var Event : TEvent); VIRTUAL;
procedure InitMenuBar; VIRTUAL;
procedure RunTestA;
procedure RunTestB;
end;
{ ══════════════════════════════════════════════════════════════════════ }
function TestBox : word; far;
{ uses ordinary Turbo Pascal I/O }
var i : integer;
S : string;
begin
Write ('Enter a STRING: ');
ReadLn (S);
For i := 1 to 800 do
begin
Write (S + ' ');
TextColor (i mod 15);
end;
TextColor (Black);
WriteLn;
Write ('Press <Enter>');
ReadLn (S);
TestBox := cmCancel;
end;
{ ══ TMyApp ════════════════════════════════════════════════════════════ }
procedure TMyApp.HandleEvent (var Event : TEvent);
begin
TApplication.HandleEvent (Event);
If Event.What = evCommand then
begin
Case Event.Command of
cmTestA: RunTestA;
cmTestB: RunTestB;
else Exit;
end;
ClearEvent (Event);
end;
end;
procedure TMyApp.InitMenuBar;
var R: TRect;
begin
GetExtent (R);
R.B.Y := succ (R.A.Y);
MenuBar := New (PMenuBar, Init (R, NewMenu (
NewItem ('Test-~A~','', kbF7, cmTestA, hcNoContext,
NewItem ('~B~', '', kbF8, cmTestB, hcNoContext,
nil))
)));
end;
procedure TMyApp.RunTestA;
var R : TRect;
D : PFuncBox;
begin
R.Assign (0,0,40 + random (40), 6 + random (12));
R.Move (random (DeskTop^.Size.X - R.B.X),
random (DeskTop^.Size.Y - R.B.Y));
D := New (PFuncBox, Init (R, 'Run Test', @TestBox));
DeskTop^.ExecView (D);
Dispose (D, Done);
end;
procedure TMyApp.RunTestB;
var R : TRect;
D : PFuncBox;
begin
Application^.GetExtent (R);
R.Grow (1,1);
D := New (PFuncBox, Init (R, '', @TestBox));
Application^.ExecView (New (PFuncBox, Init (R, '', @TestBox)));
Dispose (D, Done);
end;
{ ══════════════════════════════════════════════════════════════════════ }
var MyApp: TMyApp;
Begin
MyApp.Init;
MyApp.Run;
MyApp.Done;
End.